home *** CD-ROM | disk | FTP | other *** search
/ SuperHack / SuperHack CD.bin / CODING / PASCAL / ALLSWAGS.ZIP / SWAGG-M.ZIP / MISC.SWG / 0152_Multitasking Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-05-26  |  13.3 KB  |  370 lines

  1. {
  2. From: ka9dgx@interaccess.com (Mike Warot)
  3.  
  4.   Here is the code I wrote to do cooperative multitasking in TP4, and have
  5. since used in TP5, TP6, TP7. This version works with TP7, I make no
  6. guarantees for earlier versions.
  7. }
  8.  
  9. Unit Tasker;
  10. {
  11.   Non-Preemptive MultiTasking Unit
  12.   for Turbo Pascal Version 4
  13.  
  14.   Author  : Michael Warot - Blue Star Systems
  15.   Date    : November 1987
  16.   Purpose : Simple multi-tasking for turbo pascal 4.0
  17.   Version : 1.10
  18.  
  19.   V1.10  August    1988 MAW - After much modification, added LastP to
  20.                               point to the highest numbered active process.
  21.                               With MaxProc set to 30 and 2 tasks, took
  22.                               effective yield time down from 240 uS to 38 uS
  23.   V1.04  March     1988 MAW - Modify record used to save process, now
  24.                               use a pointer instead of 2 words to save
  25.                               the stack frame.
  26.                               Eliminate redundant variable NextP
  27.   V1.03  March,    1988 MAW - Modify code to save video state for a given
  28.                               process. A flag Video_Save toggles this.
  29.   V1.02  March,    1988 MAW - Modify code to support Sleep Function
  30.                               Added procedures LOCK and UNLOCK to permit
  31.                               use of non-reentrant procedures in programs
  32.   V1.01  January,  1988 MAW - Remove obsolete startup function Init_Tasking.
  33.                               Put in some documentation. Clean up code.
  34.   V1.00  November, 1987 MAW - Initial version, simple and crude, but it works.
  35. }
  36. {$F+    Force FAR calls - must be on}
  37. Interface
  38. Uses
  39.   Crt,Timer2;          { For saving screen status, etc }
  40.  
  41. Type
  42.   FlagPtr    = ^Boolean;                 { Pointer to a flag           }
  43. Var
  44.   Save_Video : Boolean;                  { True for cursor saving }
  45.  
  46. Function Fork:Boolean; { Call this procedure to spawn a new process. The
  47.                          procedure will return to your program twice. The
  48.                          first time it will be the root process, and will
  49.                          return a value of false, the second time it will
  50.                          return a value of true }
  51.  
  52. Procedure Raw_Yield;
  53.  
  54.  
  55. Procedure Yield;       { Call this procedure often in your code. This is the
  56.                          heart of the Multi-Tasking, it will return after all
  57.                          of the other processes have a crack at it.        }
  58.  
  59. Procedure Sleep(Flag : FlagPtr);
  60.                        { Call this procedure with an address of a flag which
  61.                          when TRUE, will re-awaken the process. Upon entry
  62.                          this procedure will test the value of this flag, and
  63.                          if FALSE, will mark the process HIBER.
  64.                          This procedure makes a call to YIELD in all cases.
  65.                          Note : Don't let all of you processes Sleep, or
  66.                          you could put things into a deadlock. }
  67.  
  68. Procedure Lock(Resource : Byte);
  69.                        { This procedure allows the programmer to insure that
  70.                          a procedure is not entered twice, it does this by
  71.                          having the second call yield until the resource is
  72.                          free, using Sleep }
  73.  
  74. Procedure UnLock(Resource : Byte);
  75.                        { This procedure unlocks a resource, allowing it to be
  76.                          used by other processes }
  77.  
  78. Procedure KillProc;    { This procedure is intended to be called by a process
  79.                          that has done all of it's work. It marks the process
  80.                          as one that is 'DEAD' and thus never re-awakens }
  81.  
  82. Function  Child_Process:Boolean;
  83.                        { This function returns True if the calling procedure
  84.                          is a child process. This test should be used to branch
  85.                          into a specific procedure for a given task.       }
  86.  
  87. Procedure SetPriority(P : Integer);
  88.  
  89. Function  ProcessCount:Integer;
  90.  
  91. Procedure Wait(TicksToWait : Longint);
  92.                        { This procedure causes a task to wait by calling
  93.                          yield until DT(timer2 unit) deterimes that
  94.                          TicksToWait timer ticks have elapsed }
  95.  
  96. Implementation
  97. {
  98.   Hide this from the users....
  99.  
  100.   These procedures work on the following basis:
  101.     1> For each process, there is an amount of memory reserved for
  102.        a machine stack, this is called a Stack Frame. This holds
  103.        the current state of a given process.
  104.  
  105.     2> The process table (Procs) contains pointers to all of the
  106.        Stack Frames. When a task is to be swapped out, it's state
  107.        is saved in it's own stack, then the frame pointer is placed
  108.        in (Procs) until the process is to be swapped back in.
  109.  
  110.     3> Every one in a while, when a task has some time to share,
  111.        it makes a call to Yield, which does all of the swapping.
  112. }
  113. Const
  114.   MaxProc   = 100;           { Maximum number of processes
  115.                                Adjust for your purposes..  }
  116.  
  117. Type
  118.   ProcState = (Dead,
  119.                Kill,
  120.                Live,
  121.                Slow,                    { Running, but in background }
  122.                Pause,                   { Waiting for above          }
  123.                Hiber);                  { What is the process doing?  }
  124.  
  125.   Task_Rec  = Record
  126.                 Frame     : Pointer;     { Frame save area}
  127.                 ID        : Word;        { Process Number }
  128.                 FrameBlk  : Pointer;     { Frame block }
  129.                 FrameSiz  : Word;        { Amount of memory user  }
  130.                 State     : ProcState;   { Is it a live process ? }
  131.                 HiberPtr  : FlagPtr;     { Pointer to "WAKE" flag }
  132.                 Priority  : LongInt;     { priority (0=Real Time) }
  133.                 NextTime  : Longint;     { Next wake up call @    }
  134.               End; { Record }
  135. Var
  136.   MaxStack  : Word;
  137.  
  138.   SFrame    : Pointer;
  139.  
  140.   Procs     : Array[0..MaxProc] of Task_Rec; { Keeps the process pointers }
  141.   NextP,                              { Last live process number  }
  142.   ThisP,                              { Current process           }
  143.   LastP     : Word;                   { Last Process number       }
  144.  
  145.   LiveCount : Word;                   { How many thing happening? }
  146.  
  147.   Locks     : Array[0..255] of Boolean; { Resource locks }
  148.  
  149.   Function  Ticks:Longint;
  150.   Begin
  151.     Inline($FA);                { CLI - Interupts off }
  152.     Ticks := MemL[$0040:$006c];
  153.     Inline($FB);                { STI - back on again }
  154.   End; { Ticks }
  155.  
  156. {
  157.   Here are the inline macros to handle the frame pointers for a task swap
  158. }
  159.   Procedure SaveFrame;
  160.     Inline( $89/$2E/SFrame        {   MOV     [0000],BP     }
  161.            /$8C/$16/SFrame+2      {   MOV     [0002],SS     } );
  162.  
  163.   Procedure LoadFrame;
  164.     Inline( $8B/$2E/SFrame        {   MOV     BP,[0000]     }
  165.            /$8E/$16/SFrame+2      {   MOV     SS,[0002]     } );
  166.  
  167. Function Fork:Boolean;                { Create a new process      }
  168. Var
  169.   Tmp : Boolean;
  170. Begin
  171.   SaveFrame;                          { Save current frame pointer }
  172.   Tmp := True;                        { Assume child process }
  173.   NextP := 0;                         { Search the process table for an }
  174.   While (NextP <= MaxProc) AND        { open entry for the new process  }
  175.         (Procs[NextP].State <> Dead) do
  176.           Inc(NextP);
  177.  
  178.   If (NextP <= MaxProc) then          { If table not full, then }
  179.   begin
  180.     If NextP > LastP then             { If We past it, bump it }
  181.       LastP := NextP;
  182.  
  183.     With Procs[NextP] do
  184.     begin
  185.       FrameSiz := MaxStack;           { Set up size of area }
  186.       GetMem(FrameBlk,FrameSiz);
  187.       State     := Live;              { Note we're ready to go.... }
  188.       ID        := NextP;             { Set up the new task       }
  189.       Frame     :=
  190.         Ptr(Seg(FrameBlk^),Ofs(SFrame^) ); { Setup stack    }
  191.  
  192.       Priority  := 0;
  193.  
  194.       Move(Mem[Seg(SFrame^)   : Ofs(SFrame^)-2],
  195.            Mem[Seg(FrameBlk^) : Ofs(SFrame^)-2],
  196.            (MaxStack+2)-Ofs(SFrame^) );
  197.     end;
  198.     Inc(LiveCount);                   { Bump process counter }
  199.     Tmp := False;
  200.   end; { we can fork }
  201.   LoadFrame;
  202.   Fork := Tmp;
  203. End; { Raw_Fork }
  204.  
  205. Procedure Raw_Yield;                  { Let the other task's go at it }
  206. Begin
  207.   SaveFrame;                          { Save our current stack frame  }
  208.   Procs[ThisP].Frame := SFrame;       { in our entry in Procs         }
  209.  
  210.   If Procs[ThisP].State = Slow then
  211.   With Procs[ThisP] do
  212.   begin
  213.     State := Pause;
  214.     NextTime := Ticks+Priority;
  215.     If NextTime > $001800ae then
  216.       NextTime := NextTime - $001800ae;
  217.   End; { with }
  218.  
  219.   If LiveCount >= 1 then              { If we actually have a task to }
  220.   begin                               { swap to, then....             }
  221.     repeat                            { keep looking until we hit a   }
  222.       If ThisP < LastP then           { live one                      }
  223.         Inc(ThisP)
  224.       else
  225.         ThisP := 0;
  226.  
  227.       With Procs[ThisP] do
  228.       Case State of
  229.         Dead,
  230.         Live    : ;
  231.  
  232.         Hiber   : If HiberPtr^ then   { Check to see if we should }
  233.                     State := Live;    { wake a sleeping process   }
  234.         Pause   : If (Priority = 0) OR
  235.                      (Ticks > NextTime) then
  236.                   begin
  237.                     State    := Slow;                   { handle slow task }
  238.                   end;
  239.         Kill    : If ThisP <> 0 then                    { Kill Off a process }
  240.                   Begin
  241.                     FreeMem(FrameBlk,FrameSiz);
  242.                     State := Dead;
  243.                   end;
  244.       End; { Case State }
  245.     until (Procs[ThisP].State = Live) or
  246.           (Procs[ThisP].State = Slow);
  247.   end;
  248.  
  249.   SFrame := Procs[ThisP].Frame;        { Load new stack frame }
  250.   LoadFrame;
  251. End; { Raw_Yield }
  252.  
  253. Procedure Yield;
  254. Var
  255.   ox,oy  : byte;
  256.   wmax,
  257.   wmin   : word;
  258.   attr   : byte;
  259. Begin
  260.   If Not Save_Video then     { Implemented this way in case the value changes }
  261.     Raw_Yield
  262.   else
  263.   begin
  264.     attr := TextAttr;                         { Save current colors  }
  265.     ox   := WhereX;         oy := WhereY;     { save cursor position }
  266.     wmin := WindMin;      wmax := WindMax;    { save window size     }
  267.  
  268.     Raw_Yield;    { actual Yield Call }
  269.  
  270.     WindMin := wmin;      WindMax := wmax;    { restore window size  }
  271.     GotoXY(ox,oy);                            { restore cursor       }
  272.     TextAttr := attr;                         { restore colors       }
  273.   end;
  274. End; { Yield_Plus }
  275.  
  276. Procedure Sleep(Flag : FlagPtr);     { Put a process to sleep           }
  277. Begin
  278.   If NOT Flag^ Then
  279.   Begin
  280.     Procs[ThisP].HiberPtr := Flag;   { Set wake up pointer }
  281.     Procs[ThisP].State    := Hiber;  { Mark this process as hibernating }
  282.   End;
  283.   Yield;                             { Do a yield, either way, to keep
  284.                                        things going smoothly            }
  285. End; { Sleep }
  286.  
  287. Procedure Lock(Resource : Byte);     { Lock a resource ID }
  288. Begin
  289.   If NOT Locks[Resource] Then        { If not open, then wait until }
  290.     Sleep(@Locks[Resource]);         { the resource becomes available }
  291.  
  292.   { Resource MUST be available now! }
  293.  
  294.   Locks[Resource] := FALSE;          { Make it unavailable for use  }
  295. End; { Lock }
  296.  
  297. Procedure UnLock(Resource : Byte);   { Unlock that resource }
  298. Begin
  299.   Locks[Resource] := True;           { Make the resource available }
  300. End; { UnLock }
  301.  
  302. Procedure KillProc;                  { Stop a process in it's tracks    }
  303. Begin
  304.   If LiveCount > 1 then              { if we are actually swapping then }
  305.   begin
  306.     Procs[ThisP].State := Kill;      {   mark us as dead                }
  307.     Dec(LiveCount);                  {   Bump process count             }
  308.     Raw_Yield;                       {   and yield. (Never returns)     }
  309. {$IFDEF DEBUG}
  310.     WriteLn('IN TASKER.PAS - FATAL ERROR, PROCESS EXCEPTION');
  311. {$ENDIF}
  312.   end
  313.   else                               { if not swapping, then            }
  314.     Halt(0);                         { exit to dos.....                 }
  315. End; { KillProc }
  316.  
  317. Function Child_Process;              { Returns true if not root process }
  318. Begin
  319.   Child_Process := ThisP <> 0;
  320. End;
  321.  
  322. Procedure SetPriority;               { Set number of clicks between runs }
  323. Begin
  324.   With Procs[ThisP] do
  325.   begin
  326.     Priority := P;
  327.     If P = 0 then
  328.       State  := Live
  329.     else
  330.       State  := Slow;
  331.   end;
  332. End;
  333.  
  334. Function ProcessCount;
  335. Begin
  336.   ProcessCount := LiveCount;
  337. End;
  338.  
  339.   Procedure Wait(TicksToWait : Longint);
  340.   var
  341.     t : longint;
  342.   begin
  343.     If TicksToWait <= 0 then EXIT;
  344.     StartTime(T);
  345.     While DT(T) < TicksToWait do Yield;
  346.   end;
  347.  
  348. { Initialization code, called automatically by the user program,
  349.   like it or not!                                                      }
  350. Procedure InitTasking;
  351. Var
  352.   i : byte;
  353. Begin
  354.   NextP := 0;                        { We are in the root process      }
  355.   ThisP := 0;
  356.   LastP := 1;                        { Last Active process             }
  357.   FillChar(Procs,SizeOf(Procs),#0);
  358.   Procs[0].State := Live;
  359.   LiveCount := 1;                    { And one task is running (this one) }
  360.   For i := 0 to 255 do
  361.     Locks[i] := True;                { All resources available }
  362.   Save_Video := True;
  363. End;
  364.  
  365. Begin
  366.   MaxStack := Sptr+4;
  367.   InitTasking;
  368. End.
  369.  
  370.